perm filename BES.SAI[JC1,MUS] blob
sn#007321 filedate 1972-06-22 generic text, type T, neo UTF8
00100 BEGIN "FM" COMMENT BY GARY GOODMAN, JULY 1971;
00200 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00300 INTEGER I,IIDEL,NI,L,R,LINE,K,DPY,DPY1,DPY2;
00400 REAL C,MF,Z,W,MI1,MI2,BEAT,ZSAVE,MAXF,MINF,DELTAF,XFACT;
00500 REAL SAVEC;
00600 STRING S,CMD,SBARF;
00700 BOOLEAN POWER,DEBUG,III,STEP_MODE,SOUND;
00800 LABEL NEXT_SET;
00900 DEFINE CRLF="('15&'12)", TIL="STEP 1 UNTIL", KMAX="33",
01000 DELY="(-100)", DELX="(-510)", CHRWIDTH="3", CHRHEIGHT="14";
01100 INTEGER ARRAY DPYBUF[1:200];
01200 REAL ARRAY J[-KMAX:KMAX];
01300
01400 PROCEDURE BARF(BOOLEAN ECHO);
01500 BEGIN INTEGER I,J; STRING S;
01600 WHILE (I←PTCHRS(LINE))≠-1 DO IF DEBUG OR ECHO THEN OUTCHR(I);
01700 END;
01800
01900 PROCEDURE INIT_PTY;
02000 BEGIN
02100 LINE←PTYGET; PTOSTR(LINE,
02200 "L
02300 1/MUS
02400 "); BARF(TRUE); PTOSTR(LINE,
02500 "RUN GARY 15
02600 TTY:
02700 "); BARF(TRUE);
02800 END;
02900
03000 PROCEDURE PLAYON;
03100 BEGIN STRING S; INTEGER F;
03200 BARF(TRUE);
03300 OUTSTR("YOU ARE NOW TALKING TO MUS, TYPE E TO EXIT"&CRLF);
03400 WHILE TRUE DO
03500 BEGIN
03600 WHILE TRUE DO
03700 BEGIN
03800 S←INCHSL(F);
03900 IF F≠-1 THEN DONE;
04000 BARF(TRUE);
04100 END;
04200 IF S='175 THEN
04300 BEGIN
04400 OUTSTR("<altmode>");
04500 PTOCHS(LINE,'175);
04600 IF LENGTH(S)>1 THEN PTOSTR(LINE,S[2 TO ∞]&CRLF);
04700 END
04800 ELSE IF S="E" THEN DONE
04900 ELSE PTOSTR(LINE,S&CRLF);
05000 END;
05100 END;
05200
05300 PROCEDURE PLAY1(REAL MI);
05400 BEGIN STRING S;
05500 S←"FM1 0 1 1500 "&CVS(C)&" "&CVF(MF)&" "&CVF(MI)&" "&CVF(MI)&" F8 F8;";
05600 BARF(TRUE);
05700 PTOSTR(LINE,"PLAY;"&S&"FINISH;"&CRLF);
05800 PLAYON;
05900 END;
06000
06100 PROCEDURE PLAY2;
06200 BEGIN STRING S;
06300 S←"FM1 0 1 1500 "&CVF(C)&" "&CVF(MF)&" "&CVF(MI1)&" "&CVF(MI2)&" F3 F3;";
06400 BARF(TRUE);
06500 PTOSTR(LINE,"PLAY;"&S&"FINISH;"&CRLF);
06600 PLAYON;
06700 END;
06800
06900 PROCEDURE ISOHZ(INTEGER M,K; REAL F,MI);
07000 BEGIN INTEGER I; REAL X,Y;
07100 FOR I←M TIL K DO
07200 BEGIN
07300 Y←J[I];
07400 IF DEBUG THEN
07500 OUTSTR(CVS(I)&":"&CVF(F)&":"&CVF(IF F<0 THEN -Y ELSE Y)&CRLF);
07600 IF POWER THEN Y←Y*Y;
07700 Y←570*Y+DELY;
07800 X←ABS(XFACT*(F-MINF))+DELX;
07900 AIVECT(X,DELY);
08000 AVECT(X,Y);
08100 IF F>0 AND Y-DELY>12 THEN
08200 BEGIN
08300 AIVECT(X-4,Y-4); AVECT(X+4,Y-4);
08400 END;
08500 F←F+MF;
08600 END;
08700 END;
08800
08900 INTEGER PROCEDURE JS(REAL MI);
09000 BEGIN INTEGER I,K; REAL J0,J1,J2,W;
09100 K←I←IF MI<.0001 THEN 0 ELSE MI+7;
09200 J[I+1]←J[I-1]←J2←0.0; J[I]←J1←.00001; W←2/MI;
09300 WHILE I≥1 DO
09400 BEGIN
09500 J[I-1]←J0←I*W*J1-J2;
09600 I←I-1; J2←J1; J1←J0;
09700 END;
09800 W←J[0]/2;
09900 FOR I←2 STEP 2 UNTIL K DO W←W+J[I];
10000 W←.5/W;
10100 FOR I←0 TIL K DO J[I]←J[I]*W;
10200 IF K>3 THEN K←K-3;
10300 RETURN(K);
10400 END;
10500
10600 PROCEDURE DPYFM(REAL MI);
10700 BEGIN INTEGER I,K,M,MM,IX,LX; REAL S,F;
10800 K←JS(MI);
10900 IF III THEN DPYSET(DPYBUF)
11000 ELSE
11100 BEGIN
11200 DPYBUF[1]←DPY1; DPYBUF[2]←DPY2;
11300 DPYRESET(DPY);
11400 END;
11500 DPYBIG(1);
11600 S←-1;
11700 FOR I←1 TIL K DO
11800 BEGIN
11900 J[-I]←S*J[I]; S←-S;
12000 END;
12100 IF R≠0 THEN ISOHZ(-K,K,C-K*MF,MI)
12200 ELSE
12300 BEGIN
12400 IX←-(M←(L-1)%2); MM←L-M;
12500 FOR I←MM TIL K DO
12600 BEGIN
12700 J[IX]←J[IX]-J[-I]; IX←IX+1;
12800 END;
12900 ISOHZ(-MM+1,K,IF L MOD 2=0 THEN 0 ELSE MF/2,MI);
13000 END;
13100 M←2*(2+K*MF/C); F←C/2; LX←I←1;
13200 WHILE I≤M AND LX<7 DO
13300 BEGIN
13400 S←(F-MINF)*XFACT+DELX; IF III THEN S←S-IIDEL;
13500 IF S>512 THEN DONE;
13600 AIVECT(S-CHRWIDTH,DELY-CHRHEIGHT); DPYSST("↑");
13700 AIVECT(S-3*CHRWIDTH,DELY-2*CHRHEIGHT);
13800 IF S>-512 THEN DPYSST(CASE LX OF ("0","C"," C","2C","4C","8C","16C"));
13900 IF I=1 AND S>-512 THEN
14000 BEGIN
14100 AIVECT(S-3*CHRWIDTH,DELY-2*CHRHEIGHT);
14200 DPYSST("_");
14300 AIVECT(S-3*CHRWIDTH,DELY-3*CHRHEIGHT-6);
14400 DPYSST("2");
14500 END;
14600 F←F+F; I←I+I; LX←LX+1;
14700 END;
14800 DPYBIG(5);
14900 AIVECT(-350,-120+DELY); DPYSST("MODULATION INDEX="&CVF(MI));
15000 IF III THEN DPYOUT(2) ELSE DPYOUT(1);
15100 END;
15200
15300 SOUND←TRUE;
15400 IF SOUND THEN INIT_PTY;
15500 III←DPYTST=0;
15600 SETFORMAT(5,3);
15700 POWER←TRUE; IIDEL←10;
15800 OUTSTR("STEP MODE?, ANSWER YES OR <blank>←");
15900 STEP_MODE←INCHWL="Y";
16000 IF NOT DEBUG THEN DPYTYP(-430,5,1);
16100 BARF(TRUE);
16200
16300 WHILE TRUE DO
16400 BEGIN
16500 OUTSTR(CRLF&"CARRIER←"); CMD←S←INCHWL; C←REALSCAN(S,I);
16600 IF C≠0 THEN CMD←"MIN" ELSE C←SAVEC;
16700
16800 IF CMD="C" THEN
16900 BEGIN I←LOP(CMD);
17000 OUTSTR(CRLF&"CARRIER←"); S←INCHWL; C←REALSCAN(S,I);
17100 END;
17200 SAVEC←C;
17300 IF CMD="M" THEN
17400 BEGIN I←LOP(CMD);
17500 OUTSTR("MOD FREQ←"); S←INCHWL; MF←REALSCAN(S,I);
17600 END;
17700 IF CMD="I" THEN
17800 BEGIN I←LOP(CMD);
17900 OUTSTR("INDEX1←"); S←INCHWL; MI1←REALSCAN(S,I);
18000 OUTSTR("INDEX2←"); S←INCHWL; MI2←REALSCAN(S,I);
18100 END;
18200 IF CMD="N" THEN
18300 BEGIN
18400 OUTSTR("NUMBER OF INCREMENTS←"); S←INCHWL; NI←REALSCAN(S,I);
18500 END;
18600 W←(MI2-MI1)/NI; ZSAVE←MI1+1;
18700 K←(MI1 MAX MI2)+4;
18800 MAXF←C+K*MF;
18900 MINF←0 MAX (C-K*MF);
19000 DELTAF←MAXF-MINF; XFACT←1020/DELTAF;
19100 L←(2.002*C)/MF;
19200 BEAT←2*C-L*MF;
19300 R←BEAT+.1; BEAT←BEAT MIN MF-BEAT; IF R=0 THEN BEAT←MF;
19400 DPYSET(DPYBUF);
19500 DPYBIG(5);
19600 AIVECT(-500,-300+DELY); SETFORMAT(5,1);
19700 DPYSST("CARRIER="&CVF(C)&" MODULATION="&CVF(MF));
19800 SETFORMAT(5,3);
19900 AIVECT(-350,-220+DELY); DPYSST("BEAT FREQUENCY="&CVF(BEAT));
20000 IF III THEN DPYOUT(1);
20100 DPY←DPYPARS; DPY1←DPYBUF[1]; DPY2←DPYBUF[2];
20200 IF MI1≠MI2 THEN FOR Z←MI1 STEP W UNTIL MI2,MI2-W STEP -W UNTIL MI1 DO
20300 BEGIN LABEL ASK;
20400 IF ABS(MI2-Z)<.000001 THEN Z←MI2;
20500 DPYFM(Z);
20600 ZSAVE←Z;
20700 IF INCHRS≠-1 OR STEP_MODE THEN
20800 BEGIN
20900 ASK:
21000 OUTSTR("TYPE <cr> TO PROCEED, E<cr> TO EXIT,
21100 S<cr> TO GET STEP="&(IF ¬STEP_MODE THEN "TRUE" ELSE "FALSE")&
21200 (IF SOUND THEN ", P<cr> TO PLAY←" ELSE "←"));
21300 IF (I←INCHWL)="E" THEN GO TO NEXT_SET
21400 ELSE IF I≠0 THEN
21500 BEGIN
21600 IF I="S" THEN STEP_MODE←NOT STEP_MODE
21700 ELSE IF I="P" THEN
21800 BEGIN
21900 IF SOUND THEN PLAY1(Z);
22000 END;
22100 GO TO ASK;
22200 END;
22300 END;
22400 END;
22500 IF ABS(ZSAVE-MI1)>.001 THEN DPYFM(MI1);
22600 NEXT_SET:
22700 IF SOUND THEN
22800 BEGIN
22900 OUTSTR("PLAY SWEEP←");
23000 IF INCHWL="Y" THEN PLAY2;
23100 END;
23200 END;
23300 END;;